home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1987 / 02 / floyd.lst < prev    next >
File List  |  1980-01-01  |  10KB  |  340 lines
  1. {Listing  1: Declarations of data structures
  2. used by hashing and symbol table routines.}
  3.  
  4. CONST
  5.    symbol_hash_size  = 100;
  6.       {Number of buckets - 1 in the hash table.
  7.        I believe it should be a prime - 1.}
  8.  
  9. TYPE
  10.    str255 = String [255]; {General large str}
  11.  
  12.    symbol_data = RECORD
  13.       {Data to be associated with identifier}
  14.       usecount: INTEGER;
  15.    END;
  16.  
  17.    symbol_name = String [255];
  18.       {Symbol identifier is a string}
  19.  
  20.    symbol_ptr = ^symbol_Type;
  21.    symbol_range = 0..symbol_hash_size;
  22.    symbol_Type = RECORD
  23.       {identifier and its data}
  24.       sym_chain: symbol_ptr;
  25.          {Ptr to next symbol in list}
  26.       sym_data:  symbol_data;
  27.          {Type declared in the main program}
  28.       sym_name:  symbol_name;
  29.          {Symbol name or identifier}
  30.    END;
  31.  
  32.    symbol_control  = RECORD
  33.       {Declare one of these in main program for
  34.       each symbol table to be used}
  35.       symbols, searches, notfound: INTEGER;
  36.       probes: REAL;
  37.          {Real because some counts exceed 32767}
  38.       this_bucket:   symbol_range;
  39.          {Bucket # of last referenced symbol}
  40.       this_symbol:  symbol_ptr;
  41.          {Pointer to last referenced symbol}
  42.       sym_ptr: ARRAY [symbol_range] OF symbol_ptr;
  43.          {Buckets}
  44.    END;
  45.  
  46.  
  47.  
  48. {Listing 2: Routines to initialize the symbol
  49. table, insert a symbol, and locate a symbol,
  50. without MTF.}
  51.  
  52. FUNCTION symbol_size
  53.    (VAR s_name: symbol_name): INTEGER;
  54.  
  55. {Return the size of memory required to contain
  56. a symbol named in  s_name.}
  57.  
  58. BEGIN
  59.    symbol_size := SIZEOF (symbol_ptr)
  60.                   + SIZEOF (symbol_data)
  61.                   + SUCC (LENGTH (s_name));
  62. END;
  63.  
  64. PROCEDURE symbol_init (VAR sym: symbol_control);
  65.  
  66. {Initialize symbol control pointers.  Call this
  67. before the first use of a Symbol_Control area.}
  68.  
  69. VAR
  70.    i: symbol_range;
  71. BEGIN
  72.    WITH sym DO BEGIN
  73.       FOR i := 0 TO symbol_hash_size
  74.          DO sym_ptr [i] := NIL;
  75.       this_bucket := 0;
  76.       this_symbol := NIL;
  77.       symbols  := 0;
  78.       searches := 0;
  79.       probes := 0.0;
  80.       notfound := 0;
  81.    END;
  82. END;
  83.  
  84. PROCEDURE symbol_put (VAR sym: symbol_control; 
  85.    s_name: symbol_name; VAR s_data: symbol_data);
  86.  
  87. {Insert symbol name and data in table.  This routine does not check for duplicate symbol.}
  88.  
  89. BEGIN
  90.    WITH sym DO BEGIN
  91.       this_bucket := symbol_hash (s_name);
  92.       GETMEM (this_symbol, symbol_size (s_name));
  93.       WITH this_symbol^ DO BEGIN
  94.          sym_chain := sym_ptr [this_bucket];
  95.          sym_data := s_data;
  96.          sym_name := s_name;
  97.          sym_ptr [this_bucket] := this_symbol;
  98.       END;
  99.       symbols := SUCC (symbols);
  100.    END;
  101. END;
  102.  
  103. FUNCTION symbol_get
  104.    (VAR sym: symbol_control; s_name: symbol_name;
  105.    VAR s_data: symbol_data): BOOLEAN;
  106.  
  107. {Retrieve a symbol.  If the symbol is found,
  108. set s_data to the data stored by the last call
  109. to symbol_put specifying the same symbol name,
  110. point this_symbol to the symbol table entry, and
  111. return TRUE.  If the symbol is not found leave
  112. s_data unchanged, leave this_symbol undefined,
  113. and return FALSE.  This version does NOT
  114. implement the MTF algorithm.}
  115.  
  116. VAR
  117.    p: symbol_ptr; {work pointer}
  118. BEGIN
  119.    WITH sym DO BEGIN
  120.       this_bucket := symbol_hash (s_name);
  121.       p := sym_ptr [this_bucket];
  122.       symbol_get := FALSE;
  123.       searches := SUCC (searches);
  124.       IF p = NIL THEN
  125.          notfound := SUCC (notfound);
  126.       WHILE p <> NIL DO WITH p^ DO BEGIN
  127.          probes := probes + 1.0;
  128.          IF s_name = sym_name THEN BEGIN
  129.             {found it!}
  130.             s_data := sym_data;
  131.             this_symbol := p;
  132.             p := NIL;
  133.             symbol_get := TRUE;
  134.          END ELSE BEGIN
  135.             {not this one, chain to the next}
  136.             p := sym_chain;
  137.             if p = NIL THEN
  138.                notfound := SUCC (notfound);
  139.          END;
  140.       END;
  141.    END;
  142. END;
  143.  
  144. {Listing 3: Hash functions, presented as a
  145. single Pascal function with case statement
  146. controlled by a global variable ``hashtype''
  147. to select one of the four routines.}
  148.  
  149. {First the table used by the CRC-16 routine,
  150. this from a public domain file uncompression
  151. program: DeArc, by Bela Lubkin.}
  152.  
  153. const crctab : array [0..255] of integer =
  154. ($0000, $C0C1, $C181, $0140, $C301, $03C0, $0280,
  155.  $C241, $C601, $06C0, $0780, $C741, $0500, $C5C1,
  156.  $C481, $0440, $CC01, $0CC0, $0D80, $CD41, $0F00,
  157.  $CFC1, $CE81, $0E40, $0A00, $CAC1, $CB81, $0B40,
  158.  $C901, $09C0, $0880, $C841, $D801, $18C0, $1980,
  159.  $D941, $1B00, $DBC1, $DA81, $1A40, $1E00, $DEC1,
  160.  $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41, $1400,
  161.  $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641,
  162.  $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081,
  163.  $1040, $F001, $30C0, $3180, $F141, $3300, $F3C1,
  164.  $F281, $3240, $3600, $F6C1, $F781, $3740, $F501,
  165.  $35C0, $3480, $F441, $3C00, $FCC1, $FD81, $3D40,
  166.  $FF01, $3FC0, $3E80, $FE41, $FA01, $3AC0, $3B80,
  167.  $FB41, $3900, $F9C1, $F881, $3840, $2800, $E8C1,
  168.  $E981, $2940, $EB01, $2BC0, $2A80, $EA41, $EE01,
  169.  $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40,
  170.  $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681,
  171.  $2640, $2200, $E2C1, $E381, $2340, $E101, $21C0,
  172.  $2080, $E041, $A001, $60C0, $6180, $A141, $6300,
  173.  $A3C1, $A281, $6240, $6600, $A6C1, $A781, $6740,
  174.  $A501, $65C0, $6480, $A441, $6C00, $ACC1, $AD81,
  175.  $6D40, $AF01, $6FC0, $6E80, $AE41, $AA01, $6AC0,
  176.  $6B80, $AB41, $6900, $A9C1, $A881, $6840, $7800,
  177.  $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41,
  178.  $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81,
  179.  $7C40, $B401, $74C0, $7580, $B541, $7700, $B7C1,
  180.  $B681, $7640, $7200, $B2C1, $B381, $7340, $B101,
  181.  $71C0, $7080, $B041, $5000, $90C1, $9181, $5140,
  182.  $9301, $53C0, $5280, $9241, $9601, $56C0, $5780,
  183.  $9741, $5500, $95C1, $9481, $5440, $9C01, $5CC0,
  184.  $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40, $5A00,
  185.  $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841,
  186.  $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81,
  187.  $4A40, $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0,
  188.  $4C80, $8C41, $4400, $84C1, $8581, $4540, $8701,
  189.  $47C0, $4680, $8641, $8201, $42C0, $4380, $8341,
  190.  $4100, $81C1, $8081, $4040 );
  191.  
  192. FUNCTION symbol_hash
  193. (VAR s_name: symbol_name): symbol_range;
  194.  
  195. {Hash the symbol name to a number between
  196. 0 and the hash table size.}
  197.  
  198. VAR
  199.    i, j: INTEGER;
  200. BEGIN
  201.    CASE hashtype OF
  202.  
  203.       1: BEGIN {Sum of the characters + length}
  204.          j := 0;
  205.          FOR i := 0 to LENGTH (s_name) DO
  206.             j := j + ORD (s_name [i]);
  207.          symbol_hash :=
  208.             j MOD SUCC (symbol_hash_size);
  209.          END;
  210.  
  211.       2: BEGIN {First + Last + Length}
  212.          symbol_hash :=
  213.             ((ORD (s_name [1]) SHL 8)
  214.             + ORD (s_name [Length (s_name)])
  215.             + Length (s_name))
  216.             MOD SUCC (symbol_hash_size);
  217.          END;
  218.  
  219.       3: BEGIN {HashPJW}
  220.          j := 0;
  221.          FOR i := 1 TO LENGTH (s_name) DO BEGIN
  222.             j := (j SHL 4) + ORD (s_name [i]);
  223.             IF (j AND $F000) <> 0 THEN 
  224.                j := j XOR (j SHR 12) AND $0FFF;
  225.          END;
  226.          symbol_hash := (j AND $7FFF)
  227.             MOD SUCC (symbol_hash_size);
  228.          END;
  229.  
  230.       4: BEGIN {CRC-16}
  231.          j := 0;
  232.          FOR i := 1 TO LENGTH (s_name) DO
  233.             j := (j SHR 8) XOR
  234.                crctab [(j XOR ORD
  235.                        (s_name [i])) AND $00FF];
  236.          symbol_hash := (j AND $7FFF)
  237.             MOD SUCC (symbol_hash_size);
  238.          END;
  239.  
  240.       else symbol_hash := 0;
  241.          {Not specified, punish the user}
  242.    END;
  243. END;
  244.  
  245.  
  246. {Listing 4: Symbol distribution function U(h,t)}
  247.  
  248. FUNCTION symbol_distribution
  249.    (VAR sym: symbol_control): REAL;
  250.  
  251. {Compute the distribution test as outlined in
  252. Aho, et al.  This  function approaches 1.0 as
  253. the ``randomness'' of the hashing improves.}
  254.  
  255. VAR
  256.    p: symbol_ptr;
  257.    b, n, m, r: REAL;
  258.    i: symbol_range;
  259.    j: INTEGER;
  260. BEGIN
  261.    r := 0.0;
  262.    WITH sym DO BEGIN
  263.       FOR i := 0 to symbol_hash_size DO BEGIN
  264.          p := sym_ptr [i];
  265.          j := 0;
  266.          WHILE p <> NIL DO
  267.             WITH p^ DO BEGIN {count the list}
  268.                p := sym_chain;
  269.                j := SUCC (j);
  270.             END;
  271.          b := j;
  272.          r := r + (b * (b + 1.0)) / 2.0;
  273.       END;
  274.       m := SUCC (symbol_hash_size);
  275.       n := symbols;
  276.       symbol_distribution := r / 
  277.          ((n / (2.0 * m)) * (n + 2.0 * m - 1.0));
  278.    END;
  279. END;
  280.  
  281.  
  282. {Listing 5: Symbol search with MTF}
  283.  
  284. {Note: for the purposes of the test program, the
  285. application of MTF is controlled by a global
  286. boolean variable ``mtf'' set by the main program.
  287. The test for this boolean should be removed in a
  288. production version of the routine.  MTF with all
  289. its performance advantages is accomplished with
  290. the addition of seven lines of code!}
  291.  
  292. FUNCTION symbol_get
  293.    (VAR sym: symbol_control; s_name: symbol_name;
  294.    VAR s_data: symbol_data): BOOLEAN;
  295.  
  296. {Retrieve a symbol.  If the found, s_data is set
  297. to the data stored by the last call to symbol_put
  298. specifying the same symbol name, this_symbol
  299. points to the symbol table found, the symbol is
  300. moved to the front of the chain, and the function
  301. returns TRUE.  If the symbol is not found s_data
  302. is unchanged, this_symbol is undefined, and the
  303. function returns FALSE.}
  304.  
  305. VAR
  306.    p: symbol_ptr; {work pointer}
  307. BEGIN
  308.    WITH sym DO BEGIN
  309.       this_bucket := symbol_hash (s_name);
  310.       p := sym_ptr [this_bucket];
  311.       symbol_get := FALSE;
  312.       this_symbol := NIL;
  313.       searches := SUCC (searches);
  314.       IF p = NIL THEN notfound := SUCC (notfound);
  315.       WHILE p <> NIL DO WITH p^ DO BEGIN
  316.          probes := probes + 1.0;
  317.          IF s_name = sym_name THEN BEGIN
  318.             {found it!}
  319.             IF this_symbol <> NIL THEN IF mtf THEN 
  320.             BEGIN {Move it to the front}
  321.                this_symbol^.sym_chain := sym_chain;
  322.                sym_chain := sym_ptr [this_bucket];
  323.                sym_ptr [this_bucket] := p;
  324.             END;
  325.             s_data := sym_data;
  326.             this_symbol := p;
  327.             p := NIL;
  328.             symbol_get := TRUE;
  329.          END ELSE BEGIN
  330.             {not this one, chain to the next}
  331.             this_symbol := p;
  332.             p := sym_chain;
  333.             if p = NIL THEN
  334.                notfound := SUCC (notfound);
  335.          END;
  336.       END;
  337.    END;
  338. END;
  339.  
  340.